Attribute VB_Name = "GetMachIp"
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type

Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type

Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type

Private Type IP_ADAPTER_INFO
dwNext As Long
ComboIndex As Long 'reserved
sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
dwAddressLength As Long
sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
dwIndex As Long
uType As Long
uDhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
bHaveWins As Long
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End Type

Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
(pTcpTable As Any, _
pdwSize As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(dst As Any, _
src As Any, _
ByVal bcount As Long)

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long

Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long

Public Function GetLocalIPAddress() As String

    Dim cbRequired As Long
    Dim buff() As Byte
    Dim ptr1 As Long
    Dim sIPAddr As String
    Dim Adapter As IP_ADAPTER_INFO
    Call GetAdaptersInfo(ByVal 0&, cbRequired)
    If cbRequired > 0 Then
    ReDim buff(0 To cbRequired - 1) As Byte
    
    If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
    
    
    ptr1 = VarPtr(buff(0))
    
    Do While (ptr1 <> 0)
    
    CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
    
    With Adapter
    
    sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))
    
    If Len(sIPAddr) > 0 Then Exit Do
    
    ptr1 = .dwNext
    
    End With
    Loop
    End If
    End If
    GetLocalIPAddress = sIPAddr

End Function


Private Function TrimNull(startstr As String) As String

    TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))

End Function







